home *** CD-ROM | disk | FTP | other *** search
/ Pascal Super Library / Pascal Super Library (CW International)(1997).bin / MOTOROLA / 6805V107 / 68705.PAS < prev    next >
Pascal/Delphi Source File  |  1995-05-04  |  41KB  |  1,168 lines
  1. program MC68705_Series_Software_Development;
  2.  
  3. {  M C 6 8 7 0 5  -  S e r i e s   S o f t w a r e   D e v e l o p m e n t
  4.  
  5.                              S y s t e m
  6.  
  7. Author:  D. R. Brooks
  8.          April 1989
  9.  
  10. Acknowledgements:
  11.       The functions ENVIRONMENT and SUBPROCESS are adapted from code published
  12.     by Borland International (publishers of Turbo Pascal), and in the public
  13.     domain.
  14.       The arithmetic-expression parser (in file 68705ASM.PAS) is based on the
  15.     recursive-descent parser published in "Advanced Turbo-Pascal Programming
  16.     and Techniques", by Schildt (McGraw Hill).
  17.  
  18.       Revision History:                                          Files Affected
  19. 1.01  Initial version                                            All
  20. 1.02  Fix Emulator bugs (ROL, ROR)                               68705DBG.PAS
  21. 1.03  Display count of instruction-execution cycles              68705DBG.PAS
  22. 1.04  Add Hex/Binary option to Load/Save file commands           68705   .PAS
  23. 1.05  Separate code pointers for Data & Code areas               68705ASM.PAS,
  24.       Added Logical operators (AND, OR, XOR) to exprns.          68705OPC.PAS,
  25.       Fixed bug in Exponentiation function                       68705   .PAS
  26.       Added Conditional Assembly (IF, IFNOT, ENDIF, LISCN, NOLCN)
  27.       Added error-listing to screen, when main listing to disk
  28.       Corrected Include-file depth display, consistent w. listing
  29. 1.06  Corrected listing to show mem-bank for addresses > $1000   68705   .PAS,
  30.       Assembler initialises mem. to 0, not FF                    68705ASM.PAS,
  31.       Assembler names accept '%', '@', 'A'..'Z', '_'             68705DBG.PAS
  32.       Amend listing to include execution cycles
  33.       Variable Stack bounds for different machines
  34. 1.07  Re-compiled for publication as Free Software         68705   .PAS
  35.       
  36. ***************************************************************************
  37.  
  38.       Compiler: Borland Turbo-Pascal, Revision 3.00
  39.  
  40.       Compile to a .COM file, allowing this program use of about 2000
  41.        paragraphs free-store (to leave room for a word processor)
  42.  
  43. ***************************************************************************}
  44.  
  45. {$C-} {$U-}                   {Disable ^C and ^S - program will handle them}
  46.  
  47. type
  48.    Str255   = String[255];
  49.    filename = string[38];
  50.    filextn  = string[3];
  51.    symbol   = string[8];
  52.  
  53.    Regs  = record Case Integer of
  54.            1: (AX, BX, CX, DX, BP, SI, DI, DS, ES, Flags :integer);
  55.            2: (AL, AH, BL, BH, CL, CH, DL, DH            :byte);
  56.          End;
  57.  
  58.    memblk = record                               {Binary I/O file format}
  59.       mempage : array [0..255] of byte;
  60.       end;
  61.  
  62.    oprec = record                                {Machine Opcode Table}
  63.       mnemonic : symbol;      {Op-code mnemonic}
  64.       stub,                   {Basic hex. opcode if +ve, or command if -ve}
  65.       modes    : integer;     {Addressing modes, bit-mapped}
  66.       end;
  67.    oplist      = array[1..127] of oprec; {Table of opcodes}
  68.  
  69.    ViewControl = (Initz, View, Finish);  {Mode controls for Viewer}
  70.  
  71. const
  72.    digit        : set of char = ['0'..'9'];
  73.    logline      : integer     = 16;              {Report line for subtasks}
  74.    filstem      = ' Default File: ';  {Flag work-file on screen}
  75.    srcextn      : filextn = 'SRC';    {Std. extension for Source files}
  76.    lstextn      : filextn = 'LST';    {Std. extension for Listing files}
  77.    hexextn      : filextn = 'HEX';    {Std. extension for Hex. files}
  78.    binextn      : filextn = 'BIN';    {Std. extension for Binary files}
  79.    comenv       = 'COMSPEC';          {Environment key - DOS Command}
  80.    wprenv       = 'WORDPATH';         {Environment key - Word Processor}
  81.  
  82.    Nofile      : string[6]   = '<None>';      {Null-file name}
  83.    version     : string[4]   = '1.07';        {Program Version no.}
  84.    whitespace  : set of char = [' ' , #9];
  85.    upper       : set of char = ['A'..'Z'];
  86.    lower       : set of char = ['a'..'z'];
  87.    symchar     : set of char = ['%','@'..'Z','_'];  {Legal assembler names}
  88.  
  89.    TAB         : char = ^I;
  90.    CR          : char = ^M;
  91.    LF          : char = ^J;
  92.    ESC         : char = #27;
  93.    ENDFILE     : char = ^Z;
  94.  
  95. {$I 68705OPC.PAS}            {Local to Assembler, but nested Includes illegal}
  96.  
  97.                              {Descriptors shared by Assembler & Debugger}
  98. type
  99.    AdrMode = (BTB, BSC, REL, IMM, DIR, EXT, INHA, INHX, IX2, IX1, IX);
  100.  
  101.    ExClass = (BitTest, BitSetClr, BranchRel, RdModWrt, Control, RegMem);
  102.  
  103.    ExRec = record                         {Instruction Decoding Record}
  104.            admode  : AdrMode;                {Addressing Mode}
  105.            opclass : ExClass;                {Operation Class}
  106.            cycles  : array[0..15] of byte;   {Machine cycles - 0 =illegal}
  107.            bytes   : byte;                   {Length of Instruction}
  108.            end;
  109.  
  110.    ExList= array [0..15] of ExRec;
  111.  
  112. const
  113.    ExTable  : ExList = (
  114. {0} (admode: BTB;  opclass: BitTest;
  115.                    cycles: (5,5,5, 5,5,5,5,5,5,5,5,5,5,5,5,5); bytes: 3),
  116. {1} (admode: BSC;  opclass: BitSetClr;
  117.                    cycles: (5,5,5, 5,5,5,5,5,5,5,5,5,5,5,5,5); bytes: 2),
  118. {2} (admode: REL;  opclass: Branchrel;
  119.                    cycles: (3,3,3, 3,3,3,3,3,3,3,3,3,3,3,3,3); bytes: 2),
  120. {3} (admode: DIR;  opclass: RdModWrt;
  121.                    cycles: (5,0,0, 5,5,0,5,5,5,5,5,0,5,4,0,5); bytes: 2),
  122. {4} (admode: INHA; opclass: RdModWrt;
  123.                    cycles: (3,0,0, 3,3,0,3,3,3,3,3,0,3,3,0,3); bytes: 1),
  124. {5} (admode: INHX; opclass: RdModWrt;
  125.                    cycles: (3,0,0, 3,3,0,3,3,3,3,3,0,3,3,0,3); bytes: 1),
  126. {6} (admode: IX1;  opclass: RdModWrt;
  127.                    cycles: (6,0,0, 6,6,0,6,6,6,6,6,0,6,5,0,6); bytes: 2),
  128. {7} (admode: IX;   opclass: RdModWrt;
  129.                    cycles: (5,0,0, 5,5,0,5,5,5,5,5,0,5,4,0,5); bytes: 1),
  130. {8} (admode: INHA; opclass: Control;
  131.                    cycles: (9,6,0,10,0,0,0,0,0,0,0,0,0,0,2,2); bytes: 1),
  132. {9} (admode: INHA; opclass: Control;
  133.                    cycles: (0,0,0, 0,0,0,0,2,2,2,2,2,2,2,0,2); bytes: 1),
  134. {A} (admode: IMM;  opclass: RegMem;
  135.                    cycles: (2,2,2, 2,2,2,2,0,2,2,2,2,0,6,2,0); bytes: 2),
  136. {B} (admode: DIR;  opclass: RegMem;
  137.                    cycles: (3,3,3, 3,3,3,3,4,3,3,3,3,2,5,3,4); bytes: 2),
  138. {C} (admode: EXT;  opclass: RegMem;
  139.                    cycles: (4,4,4, 4,4,4,4,5,4,4,4,4,3,6,4,5); bytes: 3),
  140. {D} (admode: IX2;  opclass: RegMem;
  141.                    cycles: (5,5,5, 5,5,5,5,6,5,5,5,5,4,7,5,6); bytes: 3),
  142. {E} (admode: IX1;  opclass: RegMem;
  143.                    cycles: (4,4,4, 4,4,4,4,5,4,4,4,4,3,6,4,5); bytes: 2),
  144. {F} (admode: IX;   opclass: RegMem;
  145.                    cycles: (3,3,3, 3,3,3,3,4,3,3,3,3,2,5,3,4); bytes: 1)
  146.                        ) ;
  147.  
  148.  
  149. var
  150.    commandpath,                       {Path to DOS COMMAND processor}
  151.    wordprocpath,                      {Path to Word Processor, or null}
  152.    dfltname,                          {Main Default file name}
  153.    listname,                          {Assembler listing file}
  154.    srcname           : filename;      {and Primary source-file}
  155.    hexfile,                           {Hex. (Motorola) format File}
  156.    lstfile           : text;          {Listing File}
  157.    binfile           : file of memblk;{Binary image file}
  158.  
  159.    memvalid,                          {Memory image holds a good program}
  160.    holdup,                            {Delay re-display screen}
  161.    altered           : boolean;       {Memory image changed: needs saving}
  162.    today             : symbol;        {Current date, ex-DOS}
  163.    memmax,                            {Highest memory address, for CPU}
  164.    oldsel,                            {Last sub-task run}
  165.    runjob,                            {Choose sub-task to run}
  166.    errcount          : integer;       {Count Assembler errors seen}
  167.    memory            : array[0..8191] of byte; {The MC68705 RAM & EPROM}
  168.    prefix            : string[80];    {Message frame - Asm. & Emulator}
  169.    StackBottom,
  170.    StackTop          : integer;       {Span of stack for current m/c}
  171.  
  172. {*************** Hexadecimal Output (Listing) Routines *****************
  173.                   These all load results into PREFIX }
  174.  
  175. Procedure hexchar (loc :integer; value :byte);   {List 1 hex. character}
  176. const
  177.    hextab : array[0..15] of char =
  178.             ('0','1','2','3','4','5','6','7','8','9','A','B','C','D','E','F');
  179.  
  180. begin
  181.    prefix[loc]:= hextab[value and 15];
  182.    end;
  183.  
  184. Procedure hexbyte (loc :integer; value :byte);   {List 1 hex. byte}
  185. begin
  186.    hexchar(loc, value div 16);
  187.    hexchar(loc+1, value);
  188.    end;
  189.  
  190. Procedure hexword (loc, value :integer);         {List 1 hex. word}
  191. begin
  192.    hexbyte(loc  ,hi(value));
  193.    hexbyte(loc+2,lo(value));
  194.    end;
  195.  
  196. Function hex( a:char) :integer;      {Just the hex. value of 'a'}
  197. begin
  198.    if a in digit then
  199.       hex:= ord(a) - ord('0')
  200.    else if a in ['A'..'F'] then
  201.       hex:= ord(a) - ord('A') + 10
  202.    else
  203.       hex:= -1;
  204.    end;
  205.  
  206. Function date : symbol;              {Gets Date, as DD:MM:YY}
  207. var
  208.    registers  :Regs;                 {Machine registers for DOS call}
  209.    day, month :string[2];
  210.    year       :string[4];
  211.  
  212. begin
  213.    with registers do begin
  214.       AX := $2A00;                   {DOS call for Date}
  215.       INTR ($21, registers);         {To DOS}
  216.       str(CX:4,year);                {Unpack Year}
  217.       str(lo(DX):2,day);
  218.       str(hi(DX):2,month);           {Day & Month}
  219.       if (month[1] =' ') then month[1]:= '0'; {Leading zero in Month}
  220.       date:= day + ':' + month + ':' + copy(year,3,2);
  221.       end
  222.    end;
  223.  
  224.  
  225.  
  226. {************************** Main Program Routines ************************}
  227.  
  228. Procedure fixsystem(group :char);          {Set up hardware configuration}
  229. begin
  230.    case group of
  231.       '1': begin                           {MC1468705P3}
  232.               memmax:= 2047;
  233.               StackBottom:= 64;
  234.               StackTop:= 127;
  235.               end;
  236.       '2': begin                           {MC68705G2}
  237.               memmax:= 8191;
  238.               StackBottom:= 64;
  239.               StackTop:= 127;
  240.               end;
  241.       '3': begin                           {MC68HC705C8}
  242.               memmax:= 8191;
  243.               StackBottom:= 192;
  244.               StackTop:= 255;
  245.               end
  246.         end
  247.    end;
  248.  
  249.  
  250.  
  251. type
  252.    axis   = (xco,yco);
  253.    coord  = array[xco..yco] of integer;
  254.  
  255. const
  256.    horline   : byte = $cd;                 {Special screen chars. - effects}
  257.    verline   : byte = $ba;
  258.    topleft   : byte = $c9;
  259.    topright  : byte = $bb;
  260.    botleft   : byte = $c8;
  261.    botright  : byte = $bc;
  262.    midleft   : byte = $cc;
  263.    midright  : byte = $b9;
  264.    midtop    : byte = $cb;
  265.    midbot    : byte = $ca;
  266.    crossing  : byte = $ce;
  267.  
  268.    win1top   : coord = (2,4);              {Main screen windows}
  269.    win1bot   : coord = (27,25);
  270.    win2top   : coord = (37,4);
  271.    win2bot   : coord = (80,22);
  272.    win3top   : coord = (37,22);
  273.    win3bot   : coord = (80,24);
  274.  
  275.    cline     : integer = 9;              {No. of elements in "selector" array}
  276.  
  277. procedure choose(sel :integer);            {Display one choice}
  278. type
  279.    choice = string[20];
  280.  
  281. const
  282.    selector  : array[1..9] of choice =(
  283.                'Select Default File',
  284.                'Memory Size',
  285.                'Run DOS Command',
  286.                'Run Word Processor',
  287.                'Assembler',
  288.                'Execution Emulator',
  289.                'Load Hex./Bin. file',
  290.                'Save Hex./Bin. file',
  291.                'Exit to DOS' );
  292. begin
  293.    gotoxy(win1top[xco]+1,(2*sel)+win1top[yco]+1);
  294.    write(sel:2, '. ', selector[sel]);
  295.    end;
  296.  
  297. Function environment (arg :filename) : filename; {Get Environment String}
  298.   Type                                           {Adapted from Borland}
  299.     Env=Array [0..32767] Of Char;
  300.   Var
  301.     EPtr: ^Env;
  302.     EStr: string[255];
  303.     Done: Boolean;
  304.     I: Integer;
  305.  
  306.   Begin
  307.     for i:= 1 to length(arg) do arg[i]:= upcase(arg[i]);  {Uppercase argt.}
  308.     EPtr:=Ptr(MemW[CSeg:$002C],0);
  309.     environment:= '';
  310.     I:=0;
  311.     Done:=False;
  312.     EStr:='';
  313.     Repeat
  314.       If EPtr^[I]=#0 Then
  315.        Begin
  316.         If EPtr^[I+1]=#0 Then Done:=True;
  317.         If Copy(EStr,1,length(arg)+1) = (arg + '=') then
  318.          Begin
  319.           environment:= copy(estr,length(arg)+2,100);
  320.           Done:=True;
  321.          End;
  322.         EStr:='';
  323.        End
  324.       Else EStr:=EStr+EPtr^[I];
  325.       I:=I+1;
  326.     Until Done;
  327.   End;
  328.  
  329. procedure showfile;                        {Display current file}
  330. var
  331.    xpt, scol  : integer;
  332. begin
  333.    scol:= win3top[xco]+length(filstem)+1;
  334.    highvideo;
  335.    gotoxy(scol, win3top[yco]+1);
  336.    for xpt:= scol to win3bot[xco]-1 do write(' '); {Selective blank-out}
  337.    gotoxy(scol, win3top[yco]+1);
  338.    write(dfltname);
  339.    end;
  340.  
  341. procedure setwin(topgap :integer);         {Set a reduced-size window}
  342. begin
  343.    window ( win2top[xco]+1, win2top[yco]+topgap+1,
  344.             win2bot[xco]-1, win2bot[yco]-1);
  345.    end;
  346.  
  347.  
  348. procedure showsel(level :integer);         {Display Main-Menu choices}
  349. var
  350.    ctr : integer;
  351.  
  352. begin
  353.    window(1,1,80,25);                      {Window controls OFF}
  354.  
  355.    if (level = 0) then begin               {Zero: re-display everything}
  356.       lowvideo;
  357.       for ctr:= 1 to cline do choose(ctr);     {Main menu choices}
  358.       end
  359.    else if (level > 0) then begin          {Positive: One in highlight}
  360.       highvideo;
  361.       choose(level);
  362.       end
  363.    else begin                              {Negative: One in background}
  364.       lowvideo;
  365.       choose(-level);
  366.       end;
  367.  
  368.    window(win2top[xco]+1, win2top[yco]+1,  {Then reset working window}
  369.           win2bot[xco]-1, win2bot[yco]-1);
  370.    end;
  371.  
  372. procedure vbar(start, finish :coord);      {Draws a vertical bar on screen}
  373. var                                        {OMITTING the given end-points}
  374.    y    : integer;
  375.  
  376. begin
  377.    for y:= start[yco]+1 to finish[yco]-1 do begin
  378.       gotoxy(start[xco], y);
  379.       write(chr(verline));
  380.       end
  381.    end;
  382.  
  383. procedure hbar(start, finish :coord);      {Draws horizontal bar on screen}
  384. var                                        {OMITTING the given end-points}
  385.    x    : integer;
  386.  
  387. begin
  388.    gotoxy(start[xco]+1, start[yco]);
  389.    for x:= start[xco]+1 to finish[xco]-1 do write(chr(horline));
  390.    end;
  391.  
  392. procedure drawwindow(tlt, brt :coord);     {Draws rectangular box on screen}
  393. var
  394.    x            : integer;
  395.    diagl, diagr : coord;
  396.    waste        : char;
  397.  
  398. begin                                      {Find the diagonal points}
  399.    diagl:= tlt;     diagl[yco]:= brt[yco];
  400.    diagr:= brt;     diagr[yco]:= tlt[yco];
  401.                                            {Do the corners}
  402.    gotoxy(tlt[xco],   tlt[yco]);   write(chr(topleft));
  403.    gotoxy(diagl[xco], diagl[yco]); write(chr(botleft));
  404.    gotoxy(diagr[xco], diagr[yco]); write(chr(topright));
  405.    gotoxy(brt[xco],   brt[yco]);   write(chr(botright));
  406.  
  407.    hbar(tlt,diagr);                        {Two horizontal bars}
  408.    hbar(diagl,brt);
  409.  
  410.    vbar(tlt,diagl);                        {Two vertical bars}
  411.    vbar(diagr,brt);
  412.    end;
  413.  
  414. procedure SaveExorciser; forward;          {Called here, before mem. changes}
  415.  
  416. function mainmenu(anew :boolean) :integer; {Main Menu, & get Choice}
  417. var                               {"anew" causes complete re-draw}
  418.    savit     : char;
  419.    switch,                                 {Users choice}
  420.    ctr       : integer;
  421.    dummy     : Str255;                     {Waste input area}
  422.    
  423. const
  424.    title1     = 'Freeware by David R Brooks';  {Copyright Notice}
  425.    title2     = 'MC1468705 Series Software Development System';
  426.    willchange : set of byte = [5,7,9];     {Choices will change Memory}
  427.  
  428. function selection :integer;               {Get users selection - main menu}
  429. var
  430.    x : char;
  431.  
  432. begin
  433.    gotoxy(6,3);  clreol;
  434.    write('CR to run Highlighted task');
  435.    gotoxy(2,2);  clreol;
  436.    write('Choose from menu at Left [1-', cline:1, '] : ');
  437.    read(kbd,x);
  438.    if ((x = CR) and (oldsel > 0)) then x:= chr(oldsel+ord('0'));
  439.    write(x);
  440.    if (x in ['1'..'9']) then selection:= ord(x) - ord('0')
  441.                         else selection:= 0;
  442.    prefix:= '';                            {Cancel any log-line, after input}
  443.    end;
  444.  
  445. function yesno :char;                      {Test reply for Y or N}
  446. var                                        {on tasks which destroy Memory}
  447.    ans : char;
  448.  
  449. begin
  450.    gotoxy(2,2);
  451.    clreol;
  452.    write('Memory will be overwritten.');
  453.    gotoxy(2,3);
  454.    write('    Save Image File [Y/N] ?');
  455.    read(kbd,ans);
  456.    write(ans);
  457.    yesno:= upcase(ans);
  458.    end;
  459.  
  460. begin                         {M A I N   M E N U   D R A W N}
  461.    window(1,1,80,25);                         {Drop any existing window}
  462.    if (anew) then begin
  463.       clrscr;                                 {Blank out screen}
  464.       highvideo;
  465.       gotoxy(5,1);
  466.       write(title1);
  467.       gotoxy(37,1);
  468.       write(title2);
  469.       lowvideo;
  470.       gotoxy(5,2);
  471.       for ctr:= 1 to length(title1) do write(chr(horline));
  472.       gotoxy(37,2);
  473.       for ctr:= 1 to length(title2) do write(chr(horline));
  474.  
  475.       drawwindow(win1top,win1bot);            {Two window frames}
  476.       drawwindow(win2top,win2bot);
  477.       drawwindow(win3top,win3bot);            {Subsidiary window}
  478.       gotoxy(win3top[xco], win3top[yco]);
  479.       write(chr(midleft));
  480.       gotoxy(win3bot[xco], win3top[yco]);
  481.       write(chr(midright));
  482.       gotoxy(win3top[xco]+1, win3top[yco]+1);
  483.       write(filstem);
  484.       gotoxy(win1top[xco]+5, win1top[yco]+1);
  485.       write('M A I N   M E N U');
  486.       holdup:= false;
  487.       end;
  488.    showfile;                               {Show default filename}
  489.    showsel(0);                             {Display all choices}
  490.    if (oldsel >0) then showsel(oldsel);    {Indicate previous choice, if any}
  491.  
  492.    if not holdup then clrscr;
  493.    highvideo;
  494.    gotoxy(2,17);
  495.    clreol;
  496.    write(prefix);                          {Any log returned by Sub-Task}
  497.    if holdup then begin
  498.       write(': Hit CR');                   {Prompt}
  499.       readln(dummy);                       {Hold screen if reqd.}
  500.       clrscr;                              {Then wipe it}
  501.       gotoxy(2,17);
  502.       write(prefix);                       {Put back the report}
  503.       end;
  504.    holdup:= false;
  505.    switch:= selection;
  506.    while ((1 > switch) or (cline < switch)) do begin
  507.       highvideo;                           {Get selection}
  508.       gotoxy(2,4);
  509.       write('A digit, "1" to "', cline:1, '" please');
  510.       switch:= selection;
  511.       end;
  512.    clrscr;
  513.    if (oldsel >0) then showsel(-oldsel);    {Drop old choice}
  514.    showsel(switch);                         {New choice}
  515.    oldsel:= switch;
  516.  
  517.    if (memvalid and altered
  518.        and (lo(switch) in willchange)) then begin    {Warning...}
  519.       savit:= yesno;
  520.       while (not (savit in ['Y', 'N'])) do begin
  521.          highvideo;
  522.          gotoxy(2,4);
  523.          write('"Y" or "N", please');
  524.          savit:= yesno;
  525.          end;
  526.       if (savit = 'Y') then begin
  527.          SaveExorciser;                   {Save memory image}
  528.          altered:= false;
  529.          end
  530.       end;
  531.    mainmenu:= switch;                     {Pass back selection}
  532.    end;
  533.  
  534. {$I 68705ASM.PAS}                         {Assembler-Module code}
  535. {$I 68705SVC.PAS}                         {Services, common to Viewer & Emul.}
  536. {$I 68705VIW.PAS}                         {File Viewer Module code}
  537. {$I 68705DBG.PAS}                         {Instruction-Emulator code}
  538.  
  539.  
  540. {**************************************************************************
  541.  
  542.             S U B  -  T A S K   P R O C E D U R E S
  543.  
  544. ***************************************************************************}
  545.  
  546. function stdfile(extn :filextn) :filename;   {Standard file extn.}
  547. var
  548.    x      : integer;
  549.    tmp    : filename;
  550. begin
  551.    tmp:= dfltname;
  552.    x:= pos('.',dfltname);
  553.    if (((extn <> srcextn) or (x = 0)) and (tmp <> '')) then begin
  554.       if (x > 0) then tmp:= copy(dfltname,1,x-1);
  555.       tmp:= tmp + '.' + extn;
  556.       end;
  557.    stdfile:= tmp;
  558.    end;
  559.  
  560. function workfile ( line :integer;           {Line to put query on}
  561.                    usage :filename;          {Prompt string}
  562.                     extn :filextn;           {Default name extension}
  563.                   nullok :boolean)           {NUL message displayed}
  564.                          :filename;          {Makes correct file name}
  565. var
  566.    work : filename;
  567.    wcol : integer;
  568.  
  569. begin
  570.    gotoxy(2,line);
  571.    lowvideo;
  572.    write(usage:8, ' name: [');
  573.    wcol:= wherex;
  574.    highvideo;
  575.    write(stdfile(extn));
  576.    lowvideo;
  577.    writeln(']');
  578.    if nullok then begin
  579.       gotoxy(3,line+1);
  580.       write('"NUL" =None');
  581.       end;
  582.    gotoxy(wcol-1,line+1);
  583.    write('>');
  584.    highvideo;
  585.    readln(work);
  586.    if (work = '') then work:= stdfile(extn);
  587.    if ((work = 'con') or (work = 'CON')) then work:= 'CON:';
  588.    if ((pos('.', work) =0) and
  589.        (work[length(work)] <> ':'))  then work:= work + '.' + extn;
  590.    if ((copy(work,1,4) = 'NUL.') or
  591.        (copy(work,1,4) = 'nul.')) then work:= Nofile;
  592.    gotoxy(wcol,line+1);
  593.    write(work);
  594.    workfile:= work;
  595.    end;
  596.  
  597. Function SubProcess(CommandLine: Str255): Integer;
  598.                                              {Run a DOS Sub-Process}
  599.   Const                                      {Borland Public-Domain}
  600.     SSSave: Integer=0;
  601.     SPSave: Integer=0;
  602.  
  603.   Var
  604.     Registers : Regs;
  605.     FCB1,FCB2: Array [0..36] Of Byte;
  606.     PathName: filename;
  607.     CommandTail: Str255;
  608.     ParmTable: Record
  609.                  EnvSeg: Integer;
  610.                  ComLin: ^Integer;
  611.                  FCB1Pr: ^Integer;
  612.                  FCB2Pr: ^Integer;
  613.                End;
  614.     I,RegsFlags: Integer;
  615.  
  616.   Begin
  617.     If Pos(' ',CommandLine)=0 Then
  618.      Begin
  619.       PathName:=CommandLine+#0;
  620.       CommandTail:=CR;
  621.      End
  622.     Else
  623.      Begin
  624.       PathName:=Copy(CommandLine,1,Pos(' ',CommandLine)-1)+#0;
  625.       CommandTail:=Copy(CommandLine,Pos(' ',CommandLine),255)+CR;
  626.      End;
  627.     CommandTail[0]:=Pred(CommandTail[0]);
  628.     With Registers Do
  629.      Begin
  630.       FillChar(FCB1,Sizeof(FCB1),0);
  631.       AX:=$2901;
  632.       DS:=Seg(CommandTail[1]);
  633.       SI:=Ofs(CommandTail[1]);
  634.       ES:=Seg(FCB1);
  635.       DI:=Ofs(FCB1);
  636.       MsDos(Registers); { Create FCB 1 }
  637.       FillChar(FCB2,Sizeof(FCB2),0);
  638.       AX:=$2901;
  639.       ES:=Seg(FCB2);
  640.       DI:=Ofs(FCB2);
  641.       MsDos(Registers); { Create FCB 2 }
  642.       ES:=CSeg;
  643.       BX:=SSeg-CSeg+MemW[CSeg:MemW[CSeg:$0101]+$112];
  644.       AH:=$4A;
  645.       MsDos(Registers); { Deallocate unused memory }
  646.       With ParmTable Do
  647.        Begin
  648.         EnvSeg:=MemW[CSeg:$002C];
  649.         ComLin:=Addr(CommandTail);
  650.         FCB1Pr:=Addr(FCB1);
  651.         FCB2Pr:=Addr(FCB2);
  652.        End;
  653.       InLine($8D/$96/ PathName /$42/  { <DX>:=Ofs(PathName[1]); }
  654.              $8D/$9E/ ParmTable /     { <BX>:=Ofs(ParmTable);   }
  655.              $B8/$00/$4B/             { <AX>:=$4B00;            }
  656.              $1E/$55/                 { Save <DS>, <BP>         }
  657.              $16/$1F/                 { <DS>:=Seg(PathName[1]); }
  658.              $16/$07/                 { <ES>:=Seg(ParmTable);   }
  659.              $2E/$8C/$16/ SSSave /    { Save <SS> in SSSave     }
  660.              $2E/$89/$26/ SPSave /    { Save <SP> in SPSave     }
  661.              $FA/                     { Disable interrupts      }
  662.              $CD/$21/                 { Call MS-DOS             }
  663.              $FA/                     { Disable interrupts      }
  664.              $2E/$8B/$26/ SPSave /    { Restore <SP>            }
  665.              $2E/$8E/$16/ SSSave /    { Restore <SS>            }
  666.              $FB/                     { Enable interrupts       }
  667.              $5D/$1F/                 { Restore <BP>,<DS>       }
  668.              $9C/$8F/$86/ RegsFlags / { Flags:=<CPU flags>      }
  669.              $89/$86/ Registers );    { Registers.AX:=<AX>;     }
  670.  
  671.       If (RegsFlags And 1)<>0 Then SubProcess:=AX
  672.       Else SubProcess:=0;
  673.      End;
  674.   End;
  675.  
  676. procedure subprocessresult( res :integer);   {Log result of Sub-Process call}
  677. begin
  678.    case res of
  679.       0 : prefix:= '';                 {Report result of DOS-call}
  680.       1 : prefix:= 'Invalid Function';
  681.       2 : prefix:= 'Bad command or file name';
  682.       7 : prefix:= 'Memory Control Block error';
  683.       8 : prefix:= 'Insufficient Memory';
  684.      10 : prefix:= 'Environment too Big';
  685.      11 : prefix:= 'Illegal .EXE Format';
  686.       end
  687.    end;
  688.  
  689. function openbin (reading :boolean) :boolean;  {Try to open the BIN file}
  690. var
  691.    binname : filename;
  692.    hold    : boolean;
  693.  
  694. begin
  695.    binname:= workfile(6,'Bin-File',binextn,false);
  696.    assign(binfile,binname);
  697.    {$I-}
  698.    if reading then reset(binfile)
  699.               else rewrite(binfile);
  700.    {$I+}
  701.    hold:= (IOResult = 0);
  702.    if (not hold) then prefix:= 'Unable to open File';
  703.    openbin:= hold;
  704.    end;
  705.  
  706. function openhex (reading :boolean) :boolean;  {Try to open the HEX file}
  707. var
  708.    hexname : filename;
  709.    hold    : boolean;
  710.  
  711. begin
  712.    hexname:= workfile(6,'Hex-File',hexextn,false);
  713.    assign(hexfile,hexname);
  714.    {$I-}
  715.    if reading then reset(hexfile)
  716.               else rewrite(hexfile);
  717.    {$I+}
  718.    hold:= (IOResult = 0);
  719.    if (not hold) then prefix:= 'Unable to open File';
  720.    openhex:= hold;
  721.    end;
  722.  
  723. function usehex :boolean;                  {Select HEX or BIN format}
  724. var
  725.    ans : char;
  726.  
  727. const
  728.    valid : set of char = ['x', 'X', 'b', 'B'];
  729.  
  730. begin
  731.    ans:= ' ';
  732.    while not (ans in valid) do begin
  733.       gotoxy(2,2);
  734.       clreol;
  735.       lowvideo;   write('Choose E');
  736.       highvideo;  write('x');
  737.       lowvideo;   write('orciser or ');
  738.       highvideo;  write('B');
  739.       lowvideo;   write('inary format: ');
  740.       read(kbd,ans);
  741.       gotoxy(2,4);
  742.       write('"B" or "X", please!');
  743.       end;
  744.    gotoxy(2,4); clreol;
  745.    gotoxy(2,2); clreol;
  746.    usehex:= (upcase(ans) = 'X');
  747.    end;
  748.    
  749. function accept(line :integer) :boolean;   {User confirms task}
  750. var
  751.    ans  : char;
  752.    pos  : integer;
  753.  
  754. begin
  755.    highvideo;
  756.    gotoxy(2,line);
  757.    write('OK to Proceed [Y/CR or N]: ');
  758.    pos:= wherex;
  759.    read(kbd,ans);
  760.    while (not (ans in ['Y', 'N', 'y', 'n', CR])) do begin
  761.       gotoxy(2, line+1);
  762.       write('"Y", CR, or "N", please');
  763.       gotoxy(pos, line);
  764.       read(kbd,ans);
  765.       end;
  766.    if (upcase(ans) in ['Y', 'y', CR]) then
  767.       accept:= true
  768.    else begin
  769.       accept:= false;
  770.       prefix:= 'Cancelled by User';
  771.       end
  772.    end;
  773.  
  774. {********************************************}
  775.  
  776. procedure SelectFile;             {Choice 1: Change basic filename}
  777. begin
  778.    gotoxy(2,8);
  779.    writeln('New Default file name?');
  780.    write(' >');
  781.    readln(dfltname);
  782.    end;
  783.  
  784. {********************************************}
  785.  
  786. procedure SetMemSize;             {Choice 2: Select "EPROM" Size}
  787. var
  788.    xp, yp : integer;
  789.    ans    : char;
  790.  
  791. begin
  792.    setwin(0);                     {Set window}
  793.    clrscr;
  794.    lowvideo;
  795.    writeln;
  796.    writeln(' Select MCU Component:');
  797.    writeln;
  798.    writeln('  1:    68705P3   -  $7FF [2047]');
  799.    writeln('  2:    68705G2   - $1FFF [8191]');
  800.    writeln('  3:    68HC705C2 - $1FFF [8191]');
  801.    writeln;
  802.    highvideo;
  803.    writeln(' Current Size=', memmax:5);
  804.    writeln;
  805.    writeln;
  806.    write(' Choose [1, 2, 3] :');
  807.    xp:= wherex;
  808.    yp:= wherey;
  809.    read(kbd,ans);
  810.    write(ans);
  811.    while not (ans in ['1'..'3']) do begin
  812.       gotoxy(2,yp+2);
  813.       write(' "1", "2", or "3", Please');
  814.       gotoxy(xp,yp);
  815.       read(kbd,ans);
  816.       write(ans);
  817.       end;
  818.    fixsystem(ans);
  819.    if ans = '3' then memmax:= 8191
  820.                 else memmax:= 2047;
  821.    str(memmax:5,prefix);
  822.    prefix:= 'Current Size=' + prefix;
  823.    end;
  824.  
  825. {********************************************}
  826.  
  827.  
  828. procedure DOSCommand;             {Choice 3: Run DOS command}
  829.  
  830. const
  831.    backstr   = ' to return to 68705 System';
  832.  
  833. var
  834.    Command   : Str255;
  835.    I         : Integer;
  836.    dum       : char;
  837.  
  838. begin
  839.    lowvideo;
  840.    gotoxy(2,8);
  841.    writeln('Enter DOS Command-Line:');
  842.    writeln(' [CR to run Command processor]');
  843.    write(' >');
  844.    highvideo;
  845.    readln(Command);
  846.    window(1,1,80,25);                  {Window off for DOS}
  847.    clrscr;                             {Clear out}
  848.    highvideo;
  849.  
  850.    if (Command = '') then begin
  851.       writeln('Type EXIT', backstr);
  852.       I:= SubProcess(commandpath);                {Run the full Command Shell}
  853.       end
  854.    else begin
  855.       I:= SubProcess(commandpath + ' /C ' + Command);  {Run one Command}
  856.       writeln;                     {If quit by DOS-"EXIT", then no need to...}
  857.       highvideo;                   {Pause to let you read the DOS screen}
  858.       write('Hit any key', backstr);
  859.       read(kbd,dum);
  860.       end;
  861.  
  862.    subprocessresult(I);
  863.    end;
  864.  
  865. {********************************************}
  866.  
  867. procedure WordProcessor;          {Choice 4: Run Word Processor}
  868. var
  869.    I : integer;
  870.  
  871. begin
  872.    if (wordprocpath = '') then
  873.       prefix:= 'Word-Proc. not attached: use DOS Cmnd.'
  874.    else begin
  875.       srcname:= workfile(6, 'Edit', srcextn,false);
  876.       if accept(10) then begin
  877.          window(1,1,80,25);            {Reset the display}
  878.          clrscr;
  879.          highvideo;
  880.          I:= SubProcess(commandpath + ' /C ' +
  881.                         wordprocpath + ' ' + srcname);
  882.          subprocessresult(I);
  883.          end
  884.       end
  885.    end;
  886.  
  887. {********************************************}
  888.  
  889. procedure DoAssembly;             {Choice 5: Run the Assembler}
  890. begin
  891.    srcname := workfile(6, 'Source', srcextn, false);
  892.    listname:= workfile(9, 'Listing', lstextn, true);
  893.    if accept(13) then begin
  894.       assign(lstfile, listname);
  895.       clrscr;
  896.       memvalid:= assemble;                 {Run the Assembler proper}
  897.       holdup:= not memvalid;               {If error, pause screen}
  898.       end
  899.    end;
  900.  
  901. {********************************************}
  902.  
  903. procedure Emulator;               {Choice 6: The instruction Emulator}
  904. begin
  905.    if memvalid then begin
  906.       gotoxy(1,1);                {Introductory HELP messages}
  907.       lowvideo;
  908.       writeln('You may choose a Documentation file to be');
  909.       writeln('displayed in a Window alongside your');
  910.       writeln('Emulation run. Commonly this would be the');
  911.       writeln('Assembly listing file.');
  912.       writeln('This file is called the Viewer File.');
  913.       listname:= workfile(8,'Viewer',lstextn,true);
  914.       if accept(11) then DoEmulation;
  915.       end
  916.    else
  917.       prefix:= 'No Valid Program in Memory';
  918.    end;
  919.  
  920. {********************************************}
  921.  
  922. procedure LoadExorciser;          {Choice 7: Read a Motorola or Binary file}
  923.  
  924. procedure loadhexfile;      {Option "X" - Motorola hex. format load}
  925. var
  926.    linecount,               {File record-count}
  927.    memaddr,                 {Memory load addr.}
  928.    coladd,                  {Source-line column}
  929.    bytecount : integer;     {Count bytes in line}
  930.    temp,                    {Hold byte as read}
  931.    checksum  : byte;        {Hex. checksum}
  932.    fatal     : integer;     {Fatal file error}
  933.  
  934. function pickbyte : byte;         {Get 1 hex. byte from file}
  935. var
  936.    itmp1,
  937.    itmp2     : byte;
  938.  
  939.  
  940. begin
  941.    itmp1:= hex(prefix[coladd]) and 255;
  942.    itmp2:= hex(prefix[coladd+1]) and 255;
  943.    if ((itmp1 or itmp2) > 16) then fatal:= 1   {Invalid hex.}
  944.                               else itmp1:= (itmp1 shl 4) or itmp2;
  945.    coladd:= coladd+2;
  946.    checksum := checksum + itmp1;
  947.    bytecount:= bytecount -1;
  948.    pickbyte := itmp1;
  949.    end;
  950.  
  951. begin
  952.    if openhex(true) then begin     {Open file...}
  953.       if accept(10) then begin
  954.          memvalid:= false;
  955.          for memaddr:= 0 to memmax do memory[memaddr]:= $ff;
  956.          fatal    := 0;
  957.          linecount:= 0;
  958.          if (eof(hexfile)) then begin
  959.             prefix:= 'ZZ';            {Anything illegal}
  960.             fatal:= 4;
  961.             end
  962.          else begin
  963.             repeat
  964.                readln(hexfile,prefix);       {Get a source line}
  965.                linecount:= linecount +1;
  966.                coladd   := 3;                {Column for first hex. data}
  967.                checksum := 0;
  968.                bytecount:= pickbyte;         {Get byte count}
  969.                memaddr  := (pickbyte shl 8);
  970.                memaddr  := memaddr or pickbyte; {2-byte base addr.}
  971.                temp     := pickbyte;         {Yourdon loop for data}
  972.                while (bytecount > 0) do begin
  973.                   if ((0 <= memaddr) and (memaddr < (memmax+1))) then
  974.                      memory[memaddr]:= temp
  975.                   else
  976.                      fatal:= 2;
  977.                   memaddr := memaddr +1;
  978.                   temp    := pickbyte;
  979.                   end;
  980.                   if (checksum <> $FF) then fatal:= 3;
  981.                until (eof(hexfile) or
  982.                       (prefix[2] <> '1') or
  983.                       (fatal >0));
  984.             end;
  985.          close(hexfile);
  986.          if ((prefix[2] ='9') and
  987.              (fatal =0)) then begin       {Check it was the end record}
  988.             memvalid:= true;                  {Good program load}
  989.             str(linecount:4, prefix);
  990.             prefix:= prefix + ' Records Input';
  991.             end
  992.          else begin
  993.             str(linecount:5, prefix);
  994.             case fatal of
  995.                0: prefix:= 'No End Record at Line' + prefix;
  996.                1: prefix:= 'Invalid hex. char. in Line' + prefix;
  997.                2: prefix:= 'Address out of Range: Line' + prefix;
  998.                3: prefix:= 'Checksum Error in Line' + prefix;
  999.                4: prefix:= 'Premature end-of-file at Line' + prefix;
  1000.                end
  1001.             end
  1002.          end
  1003.       end
  1004.    end;                           {of procedure loadhexfile}
  1005.  
  1006.    procedure loadbinfile;         {Choice "B" - binary format}
  1007.    var
  1008.       memaddr,                    {memory locn. to fill}
  1009.       recount  : integer;         {count records read}
  1010.       filbuff  : memblk;          {file buffer}
  1011.  
  1012.    begin
  1013.       if openbin(true) then begin
  1014.          if accept(10) then begin
  1015.             memvalid:= false;     {Memory is trashed, until proved good}
  1016.             for memaddr:= 0 to memmax do memory[memaddr]:= $ff;
  1017.             memaddr:= 0;  recount:= 0;
  1018.             while (memaddr < memmax) and
  1019.                   (not eof(binfile)) do begin
  1020.                read(binfile,filbuff);
  1021.                recount:= recount+1;
  1022.                move(filbuff,memory[memaddr],256); {fast block move}
  1023.                memaddr:= memaddr+256;
  1024.                end;
  1025.             close(binfile);
  1026.             memvalid:= true;
  1027.             str(recount:5,prefix);
  1028.             prefix:= prefix + ' Records Input';
  1029.             end
  1030.          end
  1031.       end;                        {of procedure loadbinfile}
  1032.  
  1033.    begin
  1034.       if usehex then loadhexfile
  1035.                 else loadbinfile;
  1036.    end;                           {of procedure LoadExorciser}
  1037.  
  1038. {********************************************}
  1039.  
  1040. procedure SaveExorciser;          {Choice 8: Save Memory, in Hex./Bin. format}
  1041.  
  1042. procedure savehexfile;            {Choice "X" - Motorola hex-format save}
  1043.                                   {The routine breaks memory into 32-byte
  1044.                                    blocks, and outputs any block not all-FF}
  1045. var
  1046.    blockcount,                    {Count blocks written}
  1047.    blockptr,                      {Point to start of current Block}
  1048.    byteptr,                       {Point to current Byte}
  1049.    bufptr,                        {Pointer into file buffer}
  1050.    checksum    : integer;         {Binary sumcheck}
  1051.    NZ          : byte;            {All-FF indicator}
  1052.  
  1053. begin
  1054. if memvalid then begin            {Only run it if a good program stored}
  1055.    blockcount:= 0;
  1056.    prefix    := 'S123';     {32 bytes per line, then reserve space}
  1057.    for blockptr:= 1 to 7 do prefix:= prefix + '          ';
  1058.    if openhex(false) then begin
  1059.       if accept(10) then begin
  1060.          blockptr:= 0;                       {Pascal can't do FOR...STEP}
  1061.          while (blockptr < (memmax+1)) do begin       {Check each block}
  1062.             hexword(5,blockptr);                      {Memory address}
  1063.             bufptr:= 9;                               {Start data field}
  1064.             checksum:= 35 + lo(blockptr) + hi(blockptr);
  1065.             NZ:= $FF;
  1066.             for byteptr:= blockptr to (blockptr+31) do begin
  1067.                hexbyte(bufptr,memory[byteptr]);
  1068.                checksum:= checksum + memory[byteptr];
  1069.                bufptr  := bufptr +2;
  1070.                NZ      := NZ and memory[byteptr];     {The all-FF detector}
  1071.                end;
  1072.             if (NZ <> $FF) then begin
  1073.                hexbyte(bufptr, ((not(checksum)) and $FF)); {Valid line - output}
  1074.                writeln(hexfile,prefix);
  1075.                blockcount:= blockcount +1;
  1076.                end;
  1077.             blockptr:= blockptr+32;                   {Next block}
  1078.             end;
  1079.          writeln(hexfile,'S9030000FC');
  1080.          write(hexfile,ENDFILE);                      {DOS end-of-file mark}
  1081.          close(hexfile);
  1082.          str((blockcount+1):3,prefix);
  1083.          prefix := prefix + ' Records Written';       {Log line}
  1084.          altered:= false;                             {Memory safe, now}
  1085.          end
  1086.       end
  1087.    else
  1088.       prefix:= 'No valid program stored';
  1089.    end
  1090. end;                                     {of procedure savehexfile}
  1091.  
  1092. procedure savebinfile;                   {Choice "B" - binary format}
  1093. var
  1094.    memaddr,                              {memory pointer}
  1095.    recount  : integer;                   {count records written}
  1096.    filbuff  : memblk;                    {file buffer}
  1097. begin
  1098.    if memvalid then begin
  1099.       if openbin(false) then begin
  1100.          if accept(10) then begin
  1101.             recount:= 0;
  1102.             memaddr:= 0;
  1103.             while memaddr < memmax do begin
  1104.                move(memory[memaddr],filbuff,256);
  1105.                write(binfile,filbuff);
  1106.                recount:= recount+1;
  1107.                memaddr:= memaddr+256;
  1108.                end;
  1109.             close(binfile);
  1110.             str(recount:5,prefix);
  1111.             prefix:= prefix + ' Records written';
  1112.             end
  1113.          end
  1114.       end
  1115.    end;                                  {of procedure savebinfile}
  1116.  
  1117. begin
  1118.    if usehex then savehexfile
  1119.              else savebinfile;
  1120. end;                                     {of procedure SaveExorciser}
  1121.  
  1122. {**************************************************************************
  1123.  
  1124.                 P R O G R A M   M A I N L I N E
  1125.  
  1126. ***************************************************************************}
  1127.  
  1128. begin
  1129.    fixsystem('1');                          {Default hardware configuration}
  1130.  
  1131.    if (paramcount > 0) then dfltname:= paramstr(1)
  1132.                        else dfltname:= '';
  1133.    oldsel  := 1;                            {Default task: change name}
  1134.    today   := date;                         {Standard initialisation}
  1135.    memvalid:= false;                        {Nothing in Memory, yet}
  1136.    altered := false;                        {same}
  1137.    prefix  := 'Software Version No. ' + version; {Initial Display}
  1138.  
  1139.    commandpath := environment(comenv);
  1140.    wordprocpath:= environment(wprenv);      {Get Environment pointers}
  1141.    window(1,1,80,25);
  1142.    if (wordprocpath = '') then begin
  1143.       clrscr;
  1144.       writeln('Enter pathname for Word Processor, or CR if none');
  1145.       write(' >');
  1146.       readln(wordprocpath);                 {Get path, if none}
  1147.       end;
  1148.  
  1149.    runjob:= mainmenu(true);                 {Initialise Menu, & choose}
  1150.    while (runjob in [1..(cline-1)]) do begin
  1151.       case runjob of                        {Run the reqd. sub-task}
  1152.          1: SelectFile;
  1153.          2: SetMemSize;
  1154.          3: DOSCommand;
  1155.          4: WordProcessor;
  1156.          5: DoAssembly;
  1157.          6: Emulator;
  1158.          7: LoadExorciser;
  1159.          8: SaveExorciser;
  1160.          end;
  1161.       altered:= runjob in [5,6,7];          {Memory has been changed}
  1162.       runjob:= mainmenu(runjob in [3,4,6]); {Next choice}
  1163.       end;                                  {Choice ="cline" will exit}
  1164.  
  1165.    window(1,1,80,25);                       {The end: window off}
  1166.    clrscr;
  1167.    end.
  1168.